home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / SHADETXT.BAS < prev    next >
Encoding:
BASIC Source File  |  1997-06-20  |  3.2 KB  |  148 lines
  1. DEFINT A-Z
  2.  
  3. DECLARE SUB ShadeText (message$, x%, y%, way%)
  4.  
  5. 'Not-so-fancy shaded text
  6. '
  7. 'This is another cool way to shade your screen mode 13 text!
  8. '
  9. '3/2/1997 By: - Nick Kochakian -
  10. '
  11. 'If you have any comments or questions please e-mail me at:
  12. 'nickK@worldnet.att.net
  13. '
  14. 'Have fun! :)
  15.  
  16. ' Modified by Tika Carr (t.carr@pobox.com) on June 20, 1997
  17. '  o Fixed text locate bug
  18. '  o Renamed function to ShadeText
  19. '  o Made all verables integers (not that it mattered :)
  20. '  o Wrote a "panning effect" demo to show off a way this routine could
  21. '    be used
  22. '  o Changed SUB to use SELECT CASE
  23.  
  24. DEFINT A-Z
  25. SCREEN 13
  26.  
  27. 'Make shure message$ is longer than one character!
  28. message$ = "Just another way to shade text!" 'The message to display
  29.  
  30. x = 5
  31. y = 12
  32.  
  33. 'Ways to shade:
  34. 'way = 1 -> Dark ooze text (Works great with a palette cycling routine!)
  35. 'way = 2 -> Brighter ooze text
  36. 'way = 3 -> "Light source" right
  37. 'way = 4 -> The opposite of way = 3
  38. 'way = 5 -> "Light source" is centered
  39.  
  40. DO
  41.   ShadeText message$, x, y, 3: SLEEP 1
  42.   ShadeText message$, x, y, 5: SLEEP 1
  43.   ShadeText message$, x, y, 4: SLEEP 1
  44.   ShadeText message$, x, y, 5: SLEEP 1
  45. LOOP UNTIL INKEY$ <> ""
  46.  
  47. SCREEN 0, 0, 0, 0: WIDTH 80: COLOR 7, 0: CLS : END
  48.  
  49. SUB ShadeText (message$, x%, y%, way%)
  50.  
  51. cntr = 1
  52. col = 16
  53. cntrr = 1
  54.  
  55. msglen = LEN(message$)
  56.  
  57. LOCATE y, x
  58.  
  59. SELECT CASE way
  60.   CASE 1:
  61.     DO
  62.       COLOR col
  63.       PRINT MID$(message$, cntr, 1);
  64.       cntr = cntr + 1
  65.       col = col + 1
  66.       IF col > 30 THEN col = 16
  67.     LOOP UNTIL cntr = msglen
  68.   CASE 2:
  69.     col = 20
  70.     DO
  71.       COLOR col
  72.       PRINT MID$(message$, cntr, 1);
  73.       cntr = cntr + 1
  74.       col = col + 1
  75.       IF col > 30 THEN col = 20
  76.     LOOP UNTIL cntr = msglen
  77.   CASE 3:
  78.     col = 20
  79.     DO
  80.       COLOR col
  81.       PRINT MID$(message$, cntr, 1);
  82.       cntr = cntr + 1
  83.       col = col + 1
  84.     LOOP UNTIL cntr = msglen OR col > 30
  85.     IF cntr = msglen THEN EXIT SUB
  86.  
  87.     DO
  88.       col = col - 1
  89.       PRINT MID$(message$, cntr, 1);
  90.       cntr = cntr + 1
  91.     LOOP UNTIL col < 21 OR cntr = msglen
  92.     IF cntr = msglen THEN EXIT SUB
  93.  
  94.     DO
  95.       PRINT MID$(message$, cntr, 1);
  96.       cntr = cntr + 1
  97.     LOOP UNTIL cntr = msglen
  98.   CASE 4:
  99.     col = 30
  100.     DO
  101.       COLOR col
  102.       PRINT MID$(message$, cntr, 1);
  103.       cntr = cntr + 1
  104.       col = col - 1
  105.     LOOP UNTIL cntr = msglen OR col < 21
  106.     IF cntr = msglen THEN EXIT SUB
  107.  
  108.     DO
  109.       col = col + 1
  110.       PRINT MID$(message$, cntr, 1);
  111.       cntr = cntr + 1
  112.     LOOP UNTIL col > 30 OR cntr = msglen
  113.     IF cntr = msglen THEN EXIT SUB
  114.  
  115.     DO
  116.       PRINT MID$(message$, cntr, 1);
  117.       cntr = cntr + 1
  118.     LOOP UNTIL cntr = msglen
  119.  
  120.   CASE 5:
  121.     col = 20
  122.     DO
  123.       COLOR col
  124.       PRINT MID$(message$, cntr, 1);
  125.       cntr = cntr + 1
  126.       col = col + 1
  127.     LOOP UNTIL cntr = msglen OR col > 30
  128.     IF cntr = msglen THEN EXIT SUB
  129.  
  130.     DO
  131.       COLOR col
  132.       PRINT MID$(message$, cntr, 1);
  133.       cntr = cntr + 1
  134.       col = col - 1
  135.     LOOP UNTIL col < 21 OR cntr = msglen
  136.     IF cntr = msglen THEN EXIT SUB
  137.  
  138.     DO
  139.       PRINT MID$(message$, cntr, 1);
  140.       cntr = cntr + 1
  141.       LOOP UNTIL cntr = msglen
  142. END SELECT
  143.  
  144. END SUB
  145.  
  146.  
  147.  
  148.